home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0195.ZIP / GETFREE.LIB < prev    next >
Text File  |  1984-12-18  |  1KB  |  52 lines
  1. {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
  2. The purchaser of these procedures and functions may include them in COMPILED
  3. programs freely, but may not sell or give away the source text.
  4.  
  5.  
  6.      NOTE that any file that INCLUDES this file must also INCLUDE
  7.      the type definitions in REGPACK.TYP}
  8.  
  9. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  10.  
  11.  
  12. procedure GetFree(drive : char; VAR FreeSpace : real; VAR OKAY : boolean);
  13. const
  14.   HexTenThousand = 65536.;
  15. var
  16.   regs             : regpack;
  17.   available_clusters,
  18.   sectors_per_cluster,
  19.   bytes_per_sector : real;
  20. begin
  21.   with regs do
  22.     begin
  23.       DX := ord(UpCase(drive)) - 64;
  24.       AX := $36 shl 8;
  25.       OKAY := true;
  26.       MSDOS(regs);
  27.       if AX = $FFFF then
  28.         begin
  29.           OKAY := false;
  30.           FreeSpace := 0;
  31.         end
  32.       else
  33.         begin
  34.           if BX < 0 then
  35.             available_clusters  := BX + HexTenThousand
  36.           else available_clusters := BX;
  37.           if AX < 0 then
  38.             sectors_per_cluster := AX + HexTenThousand
  39.           else sectors_per_cluster := AX;
  40.           if CX < 0 then
  41.             bytes_per_sector := CX + HexTenThousand
  42.           else bytes_per_sector    := CX;
  43.           FreeSpace := available_clusters*sectors_per_cluster*bytes_per_sector;
  44.         end;
  45.     end; {with}
  46. end;
  47.  
  48.  
  49.  
  50.  
  51.  
  52.